ist

preamble

library(scran)
library(scuttle)
library(SingleCellExperiment)
source("code/_utils.R")

loading

(sce <- readRDS("outs/pro.rds"))

class: SingleCellExperiment 
dim: 6375 91833 
metadata(1): ths
assays(2): counts logcounts
rownames(6375): A1BG A2M ... ZYX ZZZ3
rowData names(5): sel mye nkt str tum
colnames(91833): c_1_287_2 c_1_287_3 ... c_1_364_1960 c_1_364_1966
colData names(81): cell nCount_RNA ... ctx sizeFactor
reducedDimNames(4): PCA UMAP PCB UMAQ
mainExpName: NULL
altExpNames(4): Negative SystemControl UCell COMMOT

reduction

.plt_dr(sce, "pid") + scale_color_manual(values=.pal_pid) +
.plt_dr(sce, "gid") + scale_color_manual(values=.pal_gid) +
.plt_dr(sce, "typ") + scale_color_manual(values=.pal_typ) +
.plt_dr(sce, "lv1") + scale_color_manual(values=.pal_sub) +
    plot_layout(nrow=2) & theme(
        aspect.ratio=1,
        plot.margin=margin(l=5, b=5),
        legend.justification=c(0, 0.5))

cs <- split(colnames(sce), sce$lv1)
cs <- cs[setdiff(names(cs), "tum")]
ps <- lapply(names(cs), \(.) {
    sub <- sce[, cs[[.]]]
    .plt_dr(sub, "lv2", dr="UMAQ", s=0.4, id=.) +
    scale_color_manual(values=unname(pals::trubetskoy()))
})
wrap_plots(ps, nrow=1) & theme(
    aspect.ratio=1,
    plot.margin=margin(l=5, b=5),
    legend.justification=c(0, 0.5))

marker

nkt

gs <- list(
    Tha=c("TRBC1", "TRBC2", "CD2", "CD3D", "CD3E", "CD3G", "STAT4","CD4"),
    Thn=c("CD6"),
    Tcm=c("KLF2", "TUBB2A", "TUBB2B"),
    Tfh=c("ICOS", "BCL6", "CXCL13", "CD40LG"),
    Tcn=c("CD8A", "CD8B", "CCR7", "CD28", "CD44", "CD200A"),
    Treg=c("TNFRSF4", "IL2RA", "FOXP3", "CTLA4"),
    Tex=c("KLRG1", "TIGIT", "HAVCR2", "LAG3", "PDCD1", "VCAM1", 
        "TNFRSF9", "TNFRSF18", "IFNG", "CXCR6", "GLNY", "DUSP4", "TOX"),
    Tp=c("MKI67", "TOP2A", "TUBB4A", "TUBB4B", 
        "CX3CR1", "CDK6", "GZMA", "GZMB", "GZMH", "GZMK", "EOMES"),
    NK=c("ENTPD1", "NKG7", "PRF1", "TBX21", "KLRB1", "KLRC3", "IL2RB", "CD7")
)
sub <- sce[, sce$lv1 == "nkt"]
.plt_dp(sub, "lv2", gs)

mye

gs <- list(
    AML=c(), 
    DC=c("CLEC9A", "CLEC10A", "LAMP3", "IDO1", "XCR1",
        "HLA-DPA1", "HLA-DPB1", "HLA-DQB1"),
    pDC=c("IRF8", "IRF7", "CR2", "FCRL2", "FCRL5", "CLEC4C"),
    mac.pi=c("CD68", "APOE", "MMP9", "MMP12", "MMP14", "ITGAX"),
    TAM=c("SELENOP", "CD14", "CD163", "C1QA", "C1QB", "C1QC", "CTSB"),
    mono.nc=c("FCER1G", "B2M", "AIF1", "BLVRB"),
    mono.c=c("FBP1", "PCK2", "LYZ")
)
sub <- sce[, sce$lv1 == "mye"]
.plt_dp(sub, "lv2", gs)

str

gs <- list(
    fib=c(
        "COL1A1", "COL1A2", "COL3A1", "COL6A3", "COL5A1", "COL5A2", "COL5A3", 
        "COL14A1", "CXCL10", "ACTA2", "PDGFRA", "PDGFRB", "FN1"),
    mCAF=c("DCN", "COL12A1", "MMP1", "MMP2", "IGF2", "POSTN", "MYL9", "IGFBP5"),
    FRCcts=c("CCN1", "JUNB", "JUN", "FOS", "FOSB", "CCL2", "EGR1", "EGR3", "GBP1"),
    FRCtcz=c("CCL19", "CCL21", "CXCL12", "VCAM1", "COL27A1", "FDCSP", "CLU", "CR2", "CXCL13"),
    FRCpv=c("NOTCH3", "NOTCH4", "COL18A1", "COL4A1", "HEY1", "DLL4", "CAV1", "LAMA4", "LMNA"),
    BEC=c("FLT1", "CLEC14A", "CDH5", "CD34", "CD93", "VWF"),
    LEC=c("MYO6", "SRGN", "LYVE1", "PROX1", "CXCL1", "CXCL2"),
    epi=c("KRT5", "KRT7", "KRT14", "KRT16", "KRT17", "KRT19")
)
sub <- sce[, sce$lv1 == "str"]
.plt_dp(sub, "lv2", gs)

tumor

# restrict to tumor
sig <- altExp(sce, "UCell")
sel <- rowData(sig)$typ != "t-atlas"
sub <- sig[sel, sig$lv2 == "tum"]
# average by bin
xs <- seq(-(dx <- 0.05), 1+dx, dx*2)
fq <- cut(.q(sub$fqs$tum), breaks=xs)
fq <- xs[as.integer(fq)]+dx
fq <- factor(fq, sort(unique(fq)))
mu <- aggregateAcrossCells(sub,
    ids=fq, statistics="mean",
    use.assay.type=assayNames(sub)[1])
df <- data.frame(fq=mu$ids, t(assay(mu)), check.names=FALSE)
# scale across bins
fd <- df |>
    pivot_longer(-fq) |>
    group_by(name) |>
    mutate_at("value", .z)
# order by peak
yo <- fd |>
    group_by(name) |>
    slice_max(value, with_ties=FALSE) |>
    arrange(fq, value) |>
    pull(name) |> rev()
# plotting
ggplot(fd, aes(fq, name, fill=value)) +
    geom_tile() + 
    scale_fill_gradientn(
        "z-scaled\nmean score",
        colors=rev(pals::brewer.puor(9)),
        limits=c(-2.5, 2.5), breaks=seq(-2, 2, 2)) +
    labs(x="tumor density", y=NULL) +
    coord_equal(2/3, expand=FALSE) + 
    scale_y_discrete(limits=yo) +
    .thm_fig_c("minimal") + theme(
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())

appendix

session

sessionInfo()

R version 4.5.1 (2025-06-13)
Platform: aarch64-apple-darwin20
Running under: macOS Sequoia 15.6.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/Madrid
tzcode source: internal

attached base packages:
[1] stats4    stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
 [1] ggrastr_1.0.2               patchwork_1.3.2            
 [3] ggplot2_4.0.0               tidyr_1.3.1                
 [5] dplyr_1.1.4                 scran_1.36.0               
 [7] scuttle_1.18.0              SingleCellExperiment_1.30.1
 [9] SummarizedExperiment_1.38.1 Biobase_2.68.0             
[11] GenomicRanges_1.60.0        GenomeInfoDb_1.44.3        
[13] IRanges_2.42.0              S4Vectors_0.46.0           
[15] BiocGenerics_0.54.1         generics_0.1.4             
[17] MatrixGenerics_1.20.0       matrixStats_1.5.0          

loaded via a namespace (and not attached):
 [1] tidyselect_1.2.1        vipor_0.4.7             farver_2.1.2           
 [4] S7_0.2.0                fastmap_1.2.0           bluster_1.18.0         
 [7] digest_0.6.37           rsvd_1.0.5              lifecycle_1.0.4        
[10] cluster_2.1.8.1         Cairo_1.7-0             statmod_1.5.1          
[13] magrittr_2.0.4          compiler_4.5.1          rlang_1.1.6            
[16] tools_4.5.1             igraph_2.2.1            yaml_2.3.10            
[19] knitr_1.50              labeling_0.4.3          S4Arrays_1.8.1         
[22] dqrng_0.4.1             htmlwidgets_1.6.4       DelayedArray_0.34.1    
[25] mapproj_1.2.12          RColorBrewer_1.1-3      abind_1.4-8            
[28] BiocParallel_1.42.2     withr_3.0.2             purrr_1.1.0            
[31] grid_4.5.1              beachmat_2.24.0         colorspace_2.1-2       
[34] edgeR_4.6.3             scales_1.4.0            pals_1.10              
[37] dichromat_2.0-0.1       cli_3.6.5               rmarkdown_2.30         
[40] crayon_1.5.3            metapod_1.16.0          rstudioapi_0.17.1      
[43] httr_1.4.7              ggbeeswarm_0.7.2        maps_3.4.3             
[46] parallel_4.5.1          XVector_0.48.0          vctrs_0.6.5            
[49] Matrix_1.7-4            jsonlite_2.0.0          BiocSingular_1.24.0    
[52] BiocNeighbors_2.2.0     irlba_2.3.5.1           beeswarm_0.4.0         
[55] locfit_1.5-9.12         limma_3.64.3            glue_1.8.0             
[58] codetools_0.2-20        gtable_0.3.6            UCSC.utils_1.4.0       
[61] ScaledMatrix_1.16.0     tibble_3.3.0            pillar_1.11.1          
[64] htmltools_0.5.8.1       GenomeInfoDbData_1.2.14 R6_2.6.1               
[67] evaluate_1.0.5          lattice_0.22-7          Rcpp_1.1.0             
[70] SparseArray_1.8.1       xfun_0.54               pkgconfig_2.0.3